home *** CD-ROM | disk | FTP | other *** search
/ Disc to the Future 2 / Disc to the Future Part II Programmer's Reference (Wayzata Technology)(6013)(1992).bin / MAC / THINKC / 4_0 / TERMINAL / SRCS / INTERP.C < prev    next >
Text File  |  1990-11-20  |  36KB  |  1,579 lines
  1. /*
  2.     Terminal 2.0
  3.     "Interp.c"
  4. */
  5.  
  6. #ifdef THINK_C
  7. #include "MacHeaders"
  8. #endif
  9. #ifdef applec
  10. #pragma load ":(Objects):MacHeadersMPW"
  11. #pragma segment Main2
  12. #endif
  13.  
  14. #include "interp.h"
  15.  
  16. #define    FALSE    0
  17. #define TRUE    1
  18. #define EOF        0xFF
  19. #define LINE    256        /* Maximum line size */
  20.  
  21. extern Byte EmptyStr[];    /* Empty string */
  22.  
  23. /* ----- Error codes -------------------------------------------------- */
  24.  
  25. enum errs {
  26.     EARLYEOF = 1,        /* Unexpected end of file */
  27.     UNRECOGNIZED,        /* ... unrecognized */
  28.     DUPL_DECLARE,        /* ... duplicate identifier */
  29.     TABLEOVERFLOW,        /* Symbol table full */
  30.     MEMERR,                /* Out of heap memory */
  31.     UNDECLARED,            /* ... undeclared identifier */
  32.     SYNTAX,                /* Syntax error */
  33.     MATCHERR,            /* ... unmatched */
  34.     MISSING,            /* ... missing */
  35.     NOTFUNC,            /* Not a function */
  36.     OUTOFPLACE,            /* ... out of place */
  37.     BUFFULL,            /* Token buffer overflow */
  38.     DIVIDEERR,            /* Divide by zero */
  39.     POINTERERR,            /* Pointer error */
  40.     PARAMERR            /* Parameter error */
  41. };
  42.  
  43. /* ----- Symbol table structure ---------------------------------------- */
  44.  
  45. typedef struct {
  46.     Byte *name;            /* Points to symbol name (in token buffer) */
  47.     INTEGER value;        /* Value (integer or pointer) */
  48.     Byte size;            /* 0: function, 1: char, 4: int */
  49.     Byte ind;            /* Indirection level */
  50. } SYMBOL;
  51.  
  52. /* ----- Environment for expression evaluation ------------------------- */
  53.  
  54. typedef struct {
  55.     SYMBOL *sp;            /* Local symbol table pointer */
  56.     INTEGER value;        /* Value or address of variable */
  57.     Byte size;            /* 0: function, 1: char, 4: int */
  58.     Byte ind;            /* Indirection level */
  59.     Byte adr;            /* 0: value, 1: address */
  60. } ENV;
  61.  
  62. /* ----- Function macros ----------------------------------------------- */
  63.  
  64. #define bypass()            tptr += strlen((char *)tptr) + 1
  65. #define iswhite(c)            (c == ' ' || c == '\t')
  66. #define iscsymf(c)            (isalpha(c) || c == '_')
  67. #define iscsym(c)            (isalnum(c) || c == '_')
  68.  
  69. /* ----- Function prototypes ------------------------------------------- */
  70.  
  71. Byte *allocate(long);
  72. void x2str(long, Byte *);
  73. long a2x(Byte *);
  74. Byte *token2str(short);
  75. Byte gettoken(void);
  76. Byte getok(void);
  77. Byte iskeyword(void);
  78. Byte isident(void);
  79. Byte istoken(void);
  80. Byte getword(void);
  81. Byte getcx(void);
  82. SYMBOL *addsymbol(SYMBOL *, Byte *, INTEGER, Byte, Byte);
  83. SYMBOL *findsymbol(SYMBOL *, Byte *, SYMBOL *);
  84. SYMBOL *ifsymbol(SYMBOL *, Byte *, SYMBOL *);
  85. void error(enum errs, Byte *);
  86. Boolean iftoken(Byte);
  87. void skippair(Byte, Byte);
  88. void needtoken(Byte);
  89. Byte nexttoken(void);
  90. Byte escseq(void);
  91. Byte h2(void);
  92.  
  93. void compound_statement(SYMBOL *);
  94. void statement(SYMBOL *);
  95. void statements(SYMBOL *);
  96. void skip_statements(SYMBOL *);
  97. INTEGER pfunction(Byte *, SYMBOL *);
  98.  
  99. INTEGER expression(SYMBOL *);
  100. void assign(ENV *);
  101. void or(ENV *);
  102. void and(ENV *);
  103. void eq(ENV *);
  104. void le(ENV *);
  105. void plus(ENV *);
  106. void mult(ENV *);
  107. void unary(ENV *);
  108. void variable(ENV *);
  109. void primary(ENV *);
  110. void rvalue(ENV *);
  111. void store(ENV *, INTEGER);
  112.  
  113. /* ----- Characters in source, not copied to token buffer -------------- */
  114.  
  115. #define COMMENT1    '/'
  116. #define COMMENT2    '*'
  117. #define QUOTES        '"'
  118. #define QUOTE        '\''
  119.  
  120. /* ----- Tokens (found in token buffer) -------------------------------- */
  121.  
  122. #define LINENO        127        /* '\015', must be unique */
  123. #define BREAK        'b'        /* break */
  124. #define CHAR        'c'        /* char */
  125. #define ELSE        'e'        /* else */
  126. #define FOR            'f'        /* for */
  127. #define IF            'i'        /* if */
  128. #define INT            'l'        /* int */
  129. #define RETURN        'r'        /* return */
  130. #define WHILE        'w'        /* while */
  131.  
  132. #define IDENT        'I'        /* <identifier> */
  133. #define CONSTANT    'C'        /* <constant> */
  134. #define STRING        'S'        /* <string> */
  135.  
  136. #define AUTOINC        'P'        /* ++ */
  137. #define AUTODEC        'D'        /* -- */
  138. #define EQUALTO        'E'        /* == */
  139. #define NOTEQUAL    'N'        /* != */
  140. #define GE            'G'        /* >= */
  141. #define LE            'L'        /* <= */
  142. #define AUTOADD        'A'        /* += */
  143. #define AUTOSUB        'B'        /* -= */
  144. #define AUTOMUL        'M'        /* *= */
  145. #define AUTODIV        'V'        /* /= */
  146. #define AUTOMOD        'M'        /* %= */
  147. #define ADDRESS        '@'        /* &  */
  148.  
  149. #define AND            '&'        /* && */
  150. #define OR            '|'        /* || */
  151. #define POINTER        '*'        /* pointer */
  152. #define PLUS        '+'
  153. #define    MINUS        '-'
  154. #define MULTIPLY    '*'
  155. #define DIVIDE        '/'
  156. #define MODULO        '%'
  157. #define EQUAL        '='
  158. #define LESS        '<'
  159. #define GREATER        '>'
  160. #define NOT            '!'
  161. #define LPAREN        '('
  162. #define RPAREN        ')'
  163. #define LBRACE        '{'
  164. #define RBRACE        '}'
  165. #define LBRACKET    '['
  166. #define RBRACKET    ']'
  167. #define COMMA        ','
  168. #define SEMICOLON    ';'
  169.  
  170. /* ----- Table of keywords and their tokens ---------------------------- */
  171.  
  172. static struct keywords {
  173.     Byte *kw;
  174.     Byte kwtoken;
  175. } kwds[] = {
  176.     (Byte *)"\015",        LINENO,
  177.     (Byte *)"break",    BREAK,
  178.     (Byte *)"char",        CHAR,
  179.     (Byte *)"else",        ELSE,
  180.     (Byte *)"for",        FOR,
  181.     (Byte *)"if",        IF,
  182.     (Byte *)"int",        INT,
  183.     (Byte *)"return",    RETURN,
  184.     (Byte *)"while",    WHILE,
  185.     NULL,                0
  186. };
  187.  
  188. /* ----- Table of direct translate tokens ------------------------------ */
  189.  
  190. static Byte tokens[] = {
  191.     COMMA, LBRACE, RBRACE, LPAREN, RPAREN, EQUAL, NOT, POINTER,
  192.     LESS, GREATER, AND, OR, SEMICOLON, LBRACKET, RBRACKET,
  193.     MULTIPLY, DIVIDE, MODULO, PLUS, MINUS, EOF, 0
  194. };
  195.  
  196. /* ----- Local data ---------------------------------------------------- */
  197.  
  198. /*
  199.     Memory layout:                         <- Globals
  200.     High addr    +---------------------+
  201.                 | global symbols      |
  202.                 |.....................| <- EndGlobals
  203.                 |                     |
  204.                 | local symbol        |
  205.                 | (function params)   |    <- SymTop (grows down)
  206.                 +---------------------+
  207.                 |                     |
  208.                 | free memory         |
  209.                 |                     | <- StackPtr (grows up)
  210.                 +---------------------+
  211.                 |                     | 
  212.                 | arrays and function |
  213.                 | parameters          | <- LoMem
  214.                 +---------------------+
  215.                 |                     |
  216.                 | token buffer        |
  217.                 |                     | <- TokenBuffer
  218.     Low addr    +---------------------+
  219.  
  220. */
  221.  
  222. static SYMBOL *Globals;        /* Function/variable symbol table */
  223. static SYMBOL *EndGlobals;    /* Last global symbol */
  224. static SYMBOL *SymTop;        /* Last symbol in table */
  225. static Byte *StackPtr;        /* Arrays and function parameters */
  226. static Byte *LoMem;            /* Array allocation starts here */
  227. static Byte *tptr;            /* Running token pointer */
  228. static Byte *TokenBuffer;    /* Compiled token buffer */
  229. static short skipping;        /* Semaphore used for skipping statements */
  230. static short breaking;        /* TRUE if "break" statement executed */
  231. static short returning;        /* TRUE if "return" statement executed */
  232. static INTEGER frtn;        /* Return value from a function */
  233. static long linenumber;        /* Line number in source file */
  234.  
  235. /* ----- Return remaining stack space ---------------------------------- */
  236.  
  237. INTEGER SI_stack(params)    /* Used by shell as intrinsic function */
  238. INTEGER *params;
  239. {
  240. #pragma unused(params)
  241.     return (Byte *)SymTop - StackPtr;
  242. }
  243.  
  244. /* ----- Allocate memory on the stack ---------------------------------- */
  245.  
  246. static Byte *allocate(size)
  247. register long size;
  248. {
  249.     register Byte *sp = StackPtr;
  250.  
  251.     if (size & 1)    /* Make sure stack pointer remains even */
  252.         size++;
  253.     if ((StackPtr += size) >= (Byte *)SymTop)
  254.         error (MEMERR, EmptyStr);
  255.     return sp;
  256. }
  257.  
  258. /* ----- Lexical scan and call linker ---------------------------------- */
  259.  
  260. void SI_Load(intrinsics, memory, size)
  261. register INTRINSIC *intrinsics;    /* Intrinsic functions provided by shell */
  262. Byte *memory;                    /* Start of memory provided by shell */
  263. long size;                        /* Size of memory provided by shell */
  264. {
  265.     register short tok;
  266.     register short n;
  267.  
  268.     /* Set up memory pointers */
  269.  
  270.     if (size & 1)        /* Make sure address is even */
  271.         size--;
  272.     LoMem = (Byte *)(SymTop = Globals =
  273.         (SYMBOL *)((tptr = TokenBuffer = memory) + size)) - LINE;
  274.  
  275.     /* Load token buffer */
  276.  
  277.     linenumber = 1;
  278.     do {
  279.         if (tptr >= LoMem)
  280.             error(BUFFULL, EmptyStr);
  281.         n = linenumber;
  282.  
  283.         /* *tptr++ = tok = gettoken();     Ok in THINK C but not in MPW! */
  284.         tptr++; tok = gettoken(); *(tptr - 1) = tok;
  285.  
  286.         n = linenumber - n;
  287.         switch (tok) {
  288.             case CONSTANT:
  289.             case IDENT:
  290.             case STRING:
  291.                 bypass();
  292.                 break;
  293.             case LINENO:
  294.                 ++linenumber;
  295.                 break;
  296.         }
  297.         while (n--) {
  298.             if (tptr >= LoMem)
  299.                 error(BUFFULL, EmptyStr);
  300.             *tptr++ = LINENO;
  301.         }
  302.     } while (tok != EOF);
  303.     if ((long)tptr & 1)    /* Make sure address is even */
  304.         tptr++;
  305.     linenumber = 0;    /* From now on error() must count LINENO tokens */
  306.  
  307.     /* Add intrinsic functions to symbol table */
  308.  
  309.     StackPtr = LoMem = tptr;
  310.     for ( ; intrinsics->fn; intrinsics++)
  311.         addsymbol(Globals,intrinsics->fname,(INTEGER)intrinsics->fn,0,0);
  312.  
  313.     /* Link the global variables and functions */
  314.  
  315.     tptr = TokenBuffer;
  316.     while ((tok = nexttoken()) != EOF) {
  317.         if (tok == CHAR || tok == INT) {        /* Variable declaration */
  318.             do {
  319.                 register SYMBOL *symbole;
  320.                 short ind = 0;
  321.                 while (iftoken(POINTER))
  322.                     ind++;                        /* char *xyz */
  323.                 needtoken(IDENT);
  324.                 symbole = addsymbol(Globals, tptr, 0,
  325.                     (tok == CHAR) ? 1 : sizeof(INTEGER), ind);
  326.                 bypass();
  327.                 if (iftoken(LBRACKET)) {
  328.                     if (iftoken(RBRACKET))        /* xyz[] */
  329.                         (symbole->ind)++;
  330.                     else {                        /* xyz[...] */
  331.                         short size;
  332.                         size = (symbole->size == 1 && symbole->ind == 0) ?
  333.                             1 : sizeof(INTEGER);
  334.                         symbole->value =
  335.                             (INTEGER)allocate(size * expression(Globals));
  336.                         (symbole->ind)++;
  337.                         needtoken(RBRACKET);
  338.                     }
  339.                 }
  340.                 if (iftoken(EQUAL)) {
  341.                     if (iftoken(LBRACE)) {        /* x = { xxx, ... } */
  342.                         INTEGER *p;
  343.                         symbole->value = (INTEGER)StackPtr;
  344.                         do {
  345.                             p = (INTEGER *)allocate(sizeof(INTEGER));
  346.                             *p = expression(Globals);
  347.                         } while (iftoken(COMMA));
  348.                         needtoken(RBRACE);
  349.                     } else {                    /* x = xxx */
  350.                         symbole->value = expression(Globals);
  351.                     }
  352.                 }
  353.             } while (iftoken(COMMA));
  354.             needtoken(SEMICOLON);
  355.         } else if (tok == IDENT) {        /* Function definition */
  356.             Byte *name = tptr;
  357.             bypass();
  358.             addsymbol(Globals, name, (INTEGER)tptr, 0, 0);
  359.             skippair(LPAREN, RPAREN);
  360.             skippair(LBRACE, RBRACE);            /* xyz(...) {...} */
  361.         } else
  362.             error(EARLYEOF, EmptyStr);
  363.     }
  364.     EndGlobals = SymTop;
  365. }
  366.  
  367. /* ----- Start the interpreter ----------------------------------------- */
  368.  
  369. INTEGER SI_Interpret()
  370. {
  371.     skipping = 0;
  372.     breaking = returning = FALSE;
  373.     tptr = (Byte *)"Imain\0();";
  374.     return expression(SymTop);
  375. }
  376.  
  377. /* ----- Return the next token ----------------------------------------- */
  378.  
  379. static Byte gettoken()
  380. {
  381.     register Byte tok;
  382.  
  383.     tok = getword();
  384.     if (!tok)                        /* Not a char/string constant */
  385.         if (!(tok = iskeyword()))    /* No keyword */
  386.             if (!(tok = istoken()))    /* No one character token */
  387.                 tok = isident();    /* Then should be ident. or constant */
  388.     if (!tok)
  389.         error(UNRECOGNIZED, tptr);
  390.     return tok;
  391. }
  392.  
  393. /* ----- Test to see if current word is a one character token ---------- */
  394.  
  395. static Byte istoken()
  396. {
  397.     register Byte *t = tokens;    /* Single character tokens */
  398.     register Byte t2;
  399.  
  400.     if (strlen((char *)tptr) != 1)
  401.         return 0;
  402.     while (*t)
  403.         if (*tptr == *t++) {
  404.             switch (*tptr) {
  405.                 case EOF:
  406.                     break;
  407.                 case AND:        /* Distinction between & and && */
  408.                     if ((t2 = getcx()) != AND) {
  409.                         *tptr = ADDRESS;
  410.                         SI_UngetSource(t2);
  411.                     }
  412.                     break;
  413.                 case OR:        /* Must be || */
  414.                     if (getcx() != OR)
  415.                         error(MISSING, tptr);
  416.                     break;
  417.                 case PLUS:        /* Distinction between +, ++ and += */
  418.                 case MINUS:        /* Distinction between -, -- and -= */
  419.                     if ((t2 = getcx()) == *tptr)
  420.                         *tptr = (*tptr == PLUS) ? AUTOINC : AUTODEC;
  421.                     else if (t2 == EQUAL)
  422.                         *tptr = (*tptr == PLUS) ? AUTOADD : AUTOSUB;
  423.                     else
  424.                         SI_UngetSource(t2);
  425.                     break;
  426.                 case RBRACE:    /* May be last token */
  427.                 case SEMICOLON:
  428.                     break;
  429.                 default:
  430.                     if ((t2 = getcx()) == EQUAL) {
  431.                         switch (*tptr) {
  432.                             case EQUAL:                /* == */
  433.                                 return EQUALTO;
  434.                             case NOT:                /* != */
  435.                                 return NOTEQUAL;
  436.                             case LESS:                /* <= */
  437.                                 return LE;
  438.                             case GREATER:            /* >= */
  439.                                 return GE;
  440.                             case MULTIPLY:            /* *= */
  441.                                 return AUTOMUL;
  442.                             case DIVIDE:            /* /= */
  443.                                 return AUTODIV;
  444.                             case MODULO:            /* %= */
  445.                                 return AUTOMOD;
  446.                         }
  447.                     }
  448.                     SI_UngetSource(t2);
  449.                     break;
  450.             }
  451.             return *tptr;
  452.         }
  453.     return 0;
  454. }
  455.  
  456. /* ----- Test word for a keyword --------------------------------------- */
  457.  
  458. static Byte iskeyword()
  459. {
  460.     register struct keywords *k = kwds;
  461.  
  462.     while (k->kw)
  463.         if (!strcmp((char *)k->kw, (char *)tptr))
  464.             return k->kwtoken;
  465.         else
  466.             k++;
  467.     return 0;
  468. }
  469.  
  470. /* ----- Test for an ident (or constant) ------------------------------- */
  471.  
  472. static Byte isident()
  473. {
  474.     register Byte *wd = tptr;
  475.     register long n = 0;
  476.  
  477.     if (iscsymf(*wd))            /* Letter or underscore */
  478.         return IDENT;
  479.     if (!strncmp((char *)wd, "0x", 2) || !strncmp((char *)wd, "0X", 2)) {
  480.         wd += 2;                /* 0x... hex constant */
  481.         while (*wd) {
  482.             if (!isxdigit(*wd))
  483.                 return 0;        /* Not a hex digit */
  484.             n = (n << 4) + (isdigit(*wd) ? *wd - '0':
  485.                 tolower(*wd) - 'a' + 10);
  486.             wd++;
  487.         }
  488.     } else
  489.         while (*wd) {
  490.             if (!isdigit(*wd))
  491.                 return 0;        /* Not a digit */
  492.             n = (n * 10) + (*wd -'0');
  493.             wd++;
  494.         }
  495.     x2str(n, (Byte *)tptr);        /* Converted constant */
  496.     return CONSTANT;
  497. }
  498.  
  499. /* ----- Get the next word from the input stream ----------------------- */
  500.  
  501. static Byte getword()
  502. {
  503.     register Byte *wd = tptr;
  504.     register Byte c;
  505.     register Byte tok;
  506.  
  507.     do
  508.         c = getok();                /* Bypass white space */
  509.     while (iswhite(c));
  510.     if (c == QUOTE) {
  511.         register unsigned long n = 0;
  512.         register short max = 4;        /* Maximum 4 characters */
  513.         while ((c = getcx()) != QUOTE) {
  514.             if (!max)
  515.                 error(MISSING, (Byte *)"'");/* Needs the other quote */
  516.             max--;
  517.             if (c  == '\\')            /* Escape sequence (\015) */
  518.                 c = escseq();
  519.             n = (n << 8) | (c & 0xFF);
  520.         }
  521.         x2str(n, (Byte *)tptr);        /* Build the constant value */
  522.         return CONSTANT;
  523.     }
  524.     if (c == QUOTES) {
  525.         tok = STRING;                /* Quoted string "abc" */
  526.         while ((c = getcx()) != QUOTES)
  527.             *wd++ = (c == '\\') ? escseq() : c;
  528.     } else {
  529.         tok = 0;
  530.         *wd++ = c;                    /* 1st char of word */
  531.         while (iscsym(c)) {            /* Build an ident */
  532.             c = getok();
  533.             if (iscsym(c))
  534.                 *wd++ = c;
  535.             else
  536.                 SI_UngetSource(c);
  537.         }
  538.     }
  539.     *wd = '\0';        /* Null terminate the string or word */
  540.     return tok;
  541. }
  542.  
  543. /* ----- Escape sequence in litteral constant or string ---------------- */
  544.  
  545. static Byte h2()
  546. {
  547.     register Byte v = 0;
  548.     register short n = 2;
  549.     register Byte c;
  550.  
  551.     while (n--) {
  552.         c = getcx();
  553.         if (!isxdigit(c)) {
  554.             Byte s[2];
  555.             s[0] = c;
  556.             s[1] = 0;
  557.             error(OUTOFPLACE, s);    /* Not a hex digit */
  558.         }
  559.         v = (v << 4) + (isdigit(c) ? c - '0': tolower(c) - 'a' + 10);
  560.     }
  561.     return v;
  562. }
  563.  
  564. static Byte escseq()
  565. {
  566.     register Byte c = getcx();
  567.  
  568.     return (c == 'n' ? '\012' :                /* 0x0A (LF)    */
  569.         c == 't' ? '\011' :                    /* 0x09 (TAB)    */
  570.         c == 'f' ? '\014' :                    /* 0x0C (FF)    */
  571.         c == 'a' ? '\007' :                    /* 0x07 (BEL)    */
  572.         c == 'b' ? '\010' :                    /* 0x08 (BS)    */
  573.         c == 'r' ? '\015' :                    /* 0x0D (CR)    */
  574.         c == 'v' ? '\013' :                    /* 0x0B    (VT)    */
  575.         c == '0' ? '\0' :                    /* 0x00 (NUL)    */
  576.         (c == 'x') || (c == 'X') ? h2() :    /* 2 hex digits */
  577.         c);
  578. }
  579.  
  580. /* ----- Get a character from the input stream ------------------------- */
  581.  
  582. static Byte getok()
  583. {
  584.     register short c;
  585.     register short c1;
  586.  
  587.     while ((c = SI_GetSource()) == COMMENT1) {
  588.         if ((c1 = SI_GetSource()) != COMMENT2) {
  589.             SI_UngetSource(c1);
  590.             break;
  591.         }
  592.         do {
  593.             while ((c1 = getcx()) != COMMENT2)
  594.                 if (c1 == '\015')
  595.                     ++linenumber;
  596.             c1 = getcx();
  597.             if (c1 == '\015')
  598.                 ++linenumber;
  599.         } while (c1 != COMMENT1);
  600.     }
  601.     return c;
  602. }
  603.  
  604. /* ----- Read a character from input, error if EOF --------------------- */
  605.  
  606. static Byte getcx()
  607. {
  608.     register short c;
  609.  
  610.     if ((c = SI_GetSource()) == -1)
  611.         error(EARLYEOF, EmptyStr);
  612.     return c;
  613. }
  614.  
  615. /* ----- A function is called thru a pointer --------------------------- */
  616.  
  617. static INTEGER pfunction(fp, sp)
  618. register Byte *fp;                    /* Points to function definition */
  619. SYMBOL *sp;
  620. {
  621.     register short i;
  622.     register short p = 0;            /* Number of parameters */
  623.     Byte *savetptr;                    /* Will be saved and restored */
  624.     Byte *ap = StackPtr;            /* Start of local arrays */
  625.     register INTEGER *pp;
  626.  
  627.     needtoken(LPAREN);
  628.     if (!iftoken(RPAREN)) {            /* Scan for actual parameters */
  629.         do {
  630.             pp = (INTEGER *)allocate(sizeof(INTEGER));
  631.             *pp = expression(sp);    /* Evaluate parameter */
  632.             p++;
  633.         } while (iftoken(COMMA));
  634.         needtoken(RPAREN);
  635.     }
  636.     savetptr = tptr;
  637.     if (*fp == LPAREN) {            /* Call token function */
  638.         tptr = fp;
  639.         needtoken(LPAREN);
  640.         sp = SymTop;                /* Local symbols start here */
  641.         pp = (INTEGER *)ap;
  642.         for (i = 0; i < p; i++) {    /* Params into local symbol table */
  643.             short size;
  644.             short ind = 0;
  645.             if (iftoken(CHAR))
  646.                 size = 1;
  647.             else if (iftoken(INT))
  648.                 size = sizeof(INTEGER);
  649.             else
  650.                 error(PARAMERR, EmptyStr);
  651.             while (iftoken(POINTER))
  652.                 ind++;
  653.             needtoken(IDENT);
  654.             addsymbol(sp, tptr, *pp++, size, ind);
  655.             bypass();
  656.             if (i < p-1)
  657.                 needtoken(COMMA);
  658.         }
  659.         StackPtr = ap;                /* Remove parameters from stack */
  660.         needtoken(RPAREN);
  661.         compound_statement(sp);        /* Execute the function */
  662.         SymTop = sp;                /* Release the local symbols */
  663.         breaking = returning = FALSE;
  664.     } else {                        /* Call intrinisic function */
  665.         if (*fp != 0x4E || (long)fp & 1)/* Check for LINK instruction */
  666.             error(NOTFUNC, EmptyStr);    /* ...on an even address */
  667.         frtn = (*(IFUNC)fp)(ap);
  668.         StackPtr = ap;                /* Remove parameters from stack */
  669.     }
  670.     tptr = savetptr;
  671.     return frtn;                    /* The function's return value */
  672. }
  673.  
  674. /* ----- Execute one statement or a {} block --------------------------- */
  675.  
  676. static void statements(sp)
  677. register SYMBOL *sp;
  678. {
  679.     if (iftoken(LBRACE)) {
  680.         --tptr;
  681.         compound_statement(sp);
  682.     } else
  683.         statement(sp);
  684. }
  685.  
  686. /* ----- Execute a {} statement block ---------------------------------- */
  687.  
  688. static void compound_statement(sp)
  689. register SYMBOL *sp;
  690. {
  691.     register short tok;
  692.  
  693.     if (!skipping) {
  694.         register Byte *svtptr = tptr;
  695.         register SYMBOL *spp = SymTop;    /* Local symbol table */
  696.         Byte *app = StackPtr;
  697.  
  698.         needtoken(LBRACE);
  699.         do {                            /* Local variables in block */
  700.             register SYMBOL *symbole;
  701.             short size = 1;
  702.             switch (tok = nexttoken()) {
  703.                 case INT:
  704.                     size = sizeof(INTEGER);
  705.                 case CHAR:
  706.                     do {
  707.                         short ind = 0;
  708.                         while (iftoken(POINTER))
  709.                             ind++;
  710.                         needtoken(IDENT);
  711.                         symbole = addsymbol(spp, tptr, 0, size, ind);
  712.                         bypass();
  713.                         if (iftoken(EQUAL))        /* Handle assignments */
  714.                             symbole->value = expression(sp);
  715.                         else if (iftoken(LBRACKET)) {    /* Array */
  716.                             short n =
  717.                                 (symbole->size == 1 && symbole->ind == 0) ?
  718.                                 1 : sizeof(INTEGER);
  719.                             symbole->value =
  720.                                 (INTEGER)allocate(n * expression(sp));
  721.                             (symbole->ind)++;
  722.                             needtoken(RBRACKET);
  723.                         }
  724.                     } while (iftoken(COMMA));
  725.                     needtoken(SEMICOLON);
  726.                     break;
  727.                 default:
  728.                     tptr--;
  729.                     tok = 0;
  730.             }
  731.         } while (tok);
  732.         while (!iftoken(RBRACE) && !breaking && !returning)
  733.             statements(sp);
  734.         SymTop = spp;                /* Free the local symbols */
  735.         StackPtr = app;                /* Free the local arrays */
  736.         tptr = svtptr;                /* Point to the opening brace */
  737.     }
  738.     skippair(LBRACE, RBRACE);        /* Skip to end of block */
  739. }
  740.  
  741. /* ----- Execute a single statement ------------------------------------ */
  742.  
  743. static void statement(sp)
  744. register SYMBOL *sp;
  745. {
  746.     register INTEGER rtn;
  747.     register short tok;
  748.  
  749.     switch (tok = nexttoken()) {
  750.         case IF:
  751.             /* if ( expression ) statements                 */
  752.             /* if ( expression ) statements else statements */
  753.             if (skipping) {
  754.                 skippair(LPAREN, RPAREN);
  755.                 skip_statements(sp);
  756.                 while (iftoken(ELSE))
  757.                     skip_statements(sp);
  758.                 break;
  759.             }
  760.             needtoken(LPAREN);
  761.             rtn = expression(sp);        /* Condidtion beeing tested */
  762.             needtoken(RPAREN);
  763.             if (rtn)
  764.                 statements(sp);            /* Condition is TRUE */
  765.             else
  766.                 skip_statements(sp);    /* Condition is FALSE */
  767.             while (iftoken(ELSE))
  768.                 if (rtn)                /* Do the reverse for else */
  769.                     skip_statements(sp);
  770.                 else
  771.                     statements(sp);
  772.             break;
  773.         case WHILE:
  774.             /* while ( expression) statements */
  775.             if (skipping) {
  776.                 skippair(LPAREN, RPAREN);
  777.                 skip_statements(sp);
  778.                 break;
  779.             }
  780.             {
  781.                 Byte *svtptr = tptr;
  782.                 breaking = returning = FALSE;
  783.                 do {
  784.                     tptr = svtptr;
  785.                     needtoken(LPAREN);
  786.                     rtn = expression(sp);        /* The condition tested */
  787.                     needtoken(RPAREN);
  788.                     if (rtn)                    /* Condition is TRUE */
  789.                         statements(sp);
  790.                     else                        /* Condition is FALSE */
  791.                         skip_statements(sp);
  792.                 } while (rtn && !breaking && !returning);
  793.                 breaking = FALSE;
  794.             }
  795.             break;
  796.         case FOR:
  797.             /* for (expression ; expression ; expression) statements */
  798.             if (skipping) {
  799.                 skippair(LPAREN, RPAREN);
  800.                 skip_statements(sp);
  801.                 break;
  802.             }
  803.             {
  804.                 Byte *fortest, *forloop, *forblock;
  805.                 Byte *svtptr = tptr;        /* svtptr -> 1st ( after for */
  806.  
  807.                 needtoken(LPAREN);
  808.                 if (!iftoken(SEMICOLON)) {
  809.                     expression(sp);            /* Initial expression */
  810.                     needtoken(SEMICOLON);
  811.                 }
  812.                 fortest = tptr;                /* fortest:terminating test */
  813.                 tptr = svtptr;
  814.                 skippair(LPAREN, RPAREN);
  815.                 forblock = tptr;            /* forblock: block to run */
  816.                 tptr = fortest;
  817.                 breaking = returning = FALSE;
  818.                 while (TRUE) {
  819.                     if (!iftoken(SEMICOLON)) {
  820.                         if (!expression(sp))    /* Terminating test */
  821.                             break;
  822.                         needtoken(SEMICOLON);
  823.                     }
  824.                     forloop = tptr;
  825.                     tptr = forblock;
  826.                     statements(sp);            /* The loop statement(s) */
  827.                     if (breaking || returning)
  828.                         break;
  829.                     tptr = forloop;
  830.                     if (!iftoken(RPAREN)) {
  831.                         expression(sp);        /* End of loop expression */
  832.                         needtoken(RPAREN);
  833.                     }
  834.                     tptr = fortest;
  835.                 }
  836.                 tptr = forblock;
  837.                 skip_statements(sp);        /* Skip past the block */
  838.                 breaking = FALSE;
  839.             }
  840.             break;
  841.         case RETURN:
  842.             /* return ;            */
  843.             /* return expression ; */
  844.             if (!iftoken(SEMICOLON)) {
  845.                 frtn = expression(sp);        /* Function return value */
  846.                 needtoken(SEMICOLON);
  847.             }
  848.             returning = !skipping;
  849.             break;
  850.         case BREAK:
  851.             /* break ; */
  852.             needtoken(SEMICOLON);
  853.             breaking = !skipping;
  854.             break;
  855.         case IDENT:
  856.         case POINTER:
  857.         case AUTOINC:
  858.         case AUTODEC:
  859.         case LPAREN:
  860.             /* expression ; */
  861.             --tptr;
  862.             expression(sp);
  863.             needtoken(SEMICOLON);
  864.             break;
  865.         case SEMICOLON:
  866.             /* ; */
  867.             break;
  868.         default:
  869.             error(OUTOFPLACE, token2str(tok));
  870.     }
  871. }
  872.  
  873. /* ----- Bypass statement(s) ------------------------------------------- */
  874.  
  875. static void skip_statements(sp)
  876. register SYMBOL *sp;
  877. {
  878.     skipping++;            /* Semaphore that suppresses assignments, */
  879.     statements(sp);        /* ...breaks, returns, ++, --, function calls */
  880.     --skipping;            /* Turn off semaphore */
  881. }
  882.  
  883. /* ----- Recursive descent expression analyzer ------------------------- */
  884.  
  885. static void rvalue(env)            /* Read value */
  886. register ENV *env;
  887. {
  888.     register short character;
  889.  
  890.     if (skipping) {
  891.         env->value = 1;
  892.         env->adr = FALSE;
  893.         return;
  894.     }
  895.     if (env->adr) {
  896.         switch (env->size) {
  897.             case 1:
  898.                 character = (env->ind) ? FALSE: TRUE;
  899.                 break;
  900.             case 0:
  901.             case sizeof(INTEGER):
  902.                 character = FALSE;
  903.                 break;
  904.             default:
  905.                 error(SYNTAX, EmptyStr);
  906.         }
  907.         if (character) {
  908.             register Byte *v = (Byte *)env->value;
  909.             env->value = *v;
  910.         } else {
  911.             register INTEGER *v = (INTEGER *)env->value;
  912.             env->value = *v;
  913.         }
  914.         env->adr = FALSE;
  915.     }
  916. }
  917.  
  918. static void store(env, val)        /* Store value */
  919. register ENV *env;
  920. register INTEGER val;
  921. {
  922.     register short character;
  923.  
  924.     if (skipping)
  925.         return;
  926.     if (env->adr) {
  927.         switch (env->size) {
  928.             case 1:
  929.                 character = (env->ind) ? FALSE: TRUE;
  930.                 break;
  931.             case sizeof(INTEGER):
  932.                 character = FALSE;
  933.                 break;
  934.             default:
  935.                 error(SYNTAX, EmptyStr);
  936.         }
  937.         if (character) {
  938.             register Byte *v = (Byte *)env->value;
  939.             *v = val;
  940.         } else {
  941.             register INTEGER *v = (INTEGER *)env->value;
  942.             *v = val;
  943.         }
  944.     } else
  945.         error(SYNTAX, EmptyStr);
  946. }
  947.  
  948. static INTEGER expression(sp)    /* Evaluate expression */
  949. register SYMBOL *sp;
  950. {
  951.     ENV env;
  952.  
  953.     env.sp = sp;
  954.     assign(&env);
  955.     rvalue(&env);
  956.     return env.value;        /* Return expression result */
  957. }
  958.  
  959. static void assign(env)        /* Handle assignments (=) */
  960. register ENV *env;
  961. {
  962.     ENV env2;
  963.  
  964.     or(env);
  965.     while (iftoken(EQUAL)) {
  966.         env2.sp = env->sp;
  967.         assign(&env2);
  968.         rvalue(&env2);
  969.         store(env, env2.value);
  970.     }
  971. }
  972.  
  973. static void or(env)        /* Handle logical or (||) */
  974. register ENV *env;
  975. {
  976.     ENV env2;
  977.  
  978.     and(env);
  979.     while (iftoken(OR)) {
  980.         rvalue(env);
  981.         env2.sp = env->sp;
  982.         or(&env2);
  983.         rvalue(&env2);
  984.         env->value = env->value || env2.value;
  985.     }
  986. }
  987.  
  988. static void and(env)    /* Handle logical and (&&) */
  989. register ENV *env;
  990. {
  991.     ENV env2;
  992.  
  993.     eq(env);
  994.     while (iftoken(AND)) {
  995.         rvalue(env);
  996.         env2.sp = env->sp;
  997.         and(&env2);
  998.         rvalue(&env2);
  999.         env->value = env->value && env2.value;
  1000.     }
  1001. }
  1002.  
  1003. static void eq(env)        /* Handle equal (==) and not equal (!=) */
  1004. register ENV *env;
  1005. {
  1006.     register short tok;
  1007.     ENV env2;
  1008.  
  1009.     le(env);
  1010.     while (TRUE)
  1011.         switch (tok = nexttoken()) {
  1012.             case EQUALTO:
  1013.                 rvalue(env);
  1014.                 env2.sp = env->sp;
  1015.                 eq(&env2);
  1016.                 rvalue(&env2);
  1017.                 env->value = env->value == env2.value;
  1018.                 break;
  1019.             case NOTEQUAL:
  1020.                 rvalue(env);
  1021.                 env2.sp = env->sp;
  1022.                 eq(&env2);
  1023.                 rvalue(&env2);
  1024.                 env->value = env->value != env2.value;
  1025.                 break;
  1026.             default:
  1027.                 tptr--;
  1028.                 return;
  1029.         }
  1030. }
  1031.  
  1032. static void le(env)        /* Handle relational operators: <= >= < > */
  1033. register ENV *env;
  1034. {
  1035.     register short tok;
  1036.     ENV env2;
  1037.  
  1038.     plus(env);
  1039.     while (TRUE)
  1040.         switch (tok = nexttoken()) {
  1041.             case LE:
  1042.                 rvalue(env);
  1043.                 env2.sp = env->sp;
  1044.                 le(&env2);
  1045.                 rvalue(&env2);
  1046.                 env->value = env->value <= env2.value;
  1047.                 break;
  1048.             case GE:
  1049.                 rvalue(env);
  1050.                 env2.sp = env->sp;
  1051.                 le(&env2);
  1052.                 rvalue(&env2);
  1053.                 env->value = env->value >= env2.value;
  1054.                 break;
  1055.             case LESS:
  1056.                 rvalue(env);
  1057.                 env2.sp = env->sp;
  1058.                 le(&env2);
  1059.                 rvalue(&env2);
  1060.                 env->value = env->value < env2.value;
  1061.                 break;
  1062.             case GREATER:
  1063.                 rvalue(env);
  1064.                 env2.sp = env->sp;
  1065.                 le(&env2);
  1066.                 rvalue(&env2);
  1067.                 env->value = env->value > env2.value;
  1068.                 break;
  1069.             default:
  1070.                 tptr--;
  1071.                 return;
  1072.         }
  1073. }
  1074.  
  1075. static void plus(env)            /* Handle addition and substraction */
  1076. register ENV *env;
  1077. {
  1078.     register short tok;
  1079.     register short scale;
  1080.     ENV env2;
  1081.  
  1082.     mult(env);
  1083.     while (TRUE)
  1084.         switch (tok = nexttoken()) {
  1085.             case PLUS:
  1086.                 rvalue(env);
  1087.                 env2.sp = env->sp;
  1088.                 plus(&env2);
  1089.                 rvalue(&env2);
  1090.                 scale = ((env->ind == 1 && env->size == sizeof(INTEGER)) ||
  1091.                     env->ind > 1) ? sizeof(INTEGER) : 1;
  1092.                 env->value += scale * env2.value;
  1093.                 break;
  1094.             case MINUS:
  1095.                 rvalue(env);
  1096.                 env2.sp = env->sp;
  1097.                 plus(&env2);
  1098.                 rvalue(&env2);
  1099.                 if (env->ind && env2.ind) {        /* Pointer difference */
  1100.                     if (env->ind != env2.ind)
  1101.                         error(POINTERERR, EmptyStr);
  1102.                     scale = ((env->ind == 1 &&
  1103.                         env->size == sizeof(INTEGER)) ||
  1104.                         env->ind > 1) ? sizeof(INTEGER) : 1;
  1105.                     env->value = (env->value - env2.value) / scale;
  1106.                     env->size = sizeof(INTEGER);
  1107.                     env->ind = 0;
  1108.                 } else {
  1109.                     scale = ((env->ind == 1 &&
  1110.                         env->size == sizeof(INTEGER)) ||
  1111.                         env->ind > 1) ? sizeof(INTEGER) : 1;
  1112.                     env->value -= scale * env2.value;
  1113.                 }
  1114.                 break;
  1115.             default:
  1116.                 tptr--;
  1117.                 return;
  1118.         }
  1119. }
  1120.  
  1121. static void mult(env)        /* Handle multiplication, division, modulo */
  1122. register ENV *env;
  1123. {
  1124.     register short tok;
  1125.     ENV env2;
  1126.  
  1127.     unary(env);
  1128.     while (TRUE)
  1129.         switch (tok = nexttoken()) {
  1130.             case MULTIPLY:
  1131.                 rvalue(env);
  1132.                 env2.sp = env->sp;
  1133.                 mult(&env2);
  1134.                 rvalue(&env2);
  1135.                 env->value *= env2.value;
  1136.                 break;
  1137.             case DIVIDE:
  1138.                 rvalue(env);
  1139.                 env2.sp = env->sp;
  1140.                 mult(&env2);
  1141.                 rvalue(&env2);
  1142.                  if (!env2.value)
  1143.                     error(DIVIDEERR, EmptyStr);
  1144.                 env->value /= env2.value;
  1145.                 break;
  1146.             case MODULO:
  1147.                 rvalue(env);
  1148.                 env2.sp = env->sp;
  1149.                 mult(&env2);
  1150.                 rvalue(&env2);
  1151.                  if (!env2.value)
  1152.                     error(DIVIDEERR, EmptyStr);
  1153.                 env->value %= env2.value;
  1154.                 break;
  1155.             default:
  1156.                 tptr--;
  1157.                 return;
  1158.         }
  1159. }
  1160.  
  1161. /*
  1162.     Check for:
  1163.     leading ++
  1164.     leading --
  1165.     unary -
  1166.     pointer indicator (*)
  1167.     address operator (&)
  1168.     trailing ++
  1169.     trailing --
  1170. */
  1171.  
  1172. static void unary(env)
  1173. register ENV *env;
  1174. {
  1175.     ENV env2;
  1176.  
  1177.     if (iftoken(AUTOINC)) {
  1178.         unary(env);
  1179.         env2 = *env;
  1180.         rvalue(&env2);
  1181.         env2.value += ((env->ind == 1 && env->size == sizeof(INTEGER)) ||
  1182.             env->ind > 1) ? sizeof(INTEGER) : 1;
  1183.         store(env, env2.value);
  1184.         return;
  1185.     }
  1186.  
  1187.     if (iftoken(AUTODEC)) {
  1188.         unary(env);
  1189.         env2 = *env;
  1190.         rvalue(&env2);
  1191.         env2.value -= ((env->ind == 1 && env->size == sizeof(INTEGER)) ||
  1192.             env->ind > 1) ? sizeof(INTEGER) : 1;
  1193.         store(env, env2.value);
  1194.         return;
  1195.     }
  1196.  
  1197.     if (iftoken(NOT)) {
  1198.         unary(env);
  1199.         rvalue(env);
  1200.         env->value = !env->value;
  1201.         env->size = sizeof(INTEGER);
  1202.         env->ind = 0;
  1203.         env->adr = FALSE;
  1204.         return;
  1205.     }
  1206.  
  1207.     if (iftoken(MINUS)) {
  1208.         unary(env);
  1209.         rvalue(env);
  1210.         env->value = -env->value;
  1211.         env->size = sizeof(INTEGER);
  1212.         env->ind = 0;
  1213.         env->adr = FALSE;
  1214.         return;
  1215.     }
  1216.  
  1217.     if (iftoken(POINTER)) {
  1218.         unary(env);
  1219.         rvalue(env);
  1220.         if (!env->ind)
  1221.             error(POINTERERR, EmptyStr);
  1222.         --(env->ind);
  1223.         switch (env->size) {
  1224.             case 1:
  1225.                 env->size = (env->ind) ? sizeof(INTEGER) : 1;
  1226.                 break;
  1227.             case sizeof(INTEGER):
  1228.                 env->size = sizeof(INTEGER);
  1229.                 break;
  1230.             default:
  1231.                 error(SYNTAX, EmptyStr);
  1232.         }
  1233.         env->adr = TRUE;
  1234.         return;
  1235.     }
  1236.  
  1237.     if (iftoken(ADDRESS)) {
  1238.         unary(env);
  1239.         if (!env->adr)
  1240.             error(SYNTAX, EmptyStr);
  1241.         env->size = sizeof(INTEGER);
  1242.         env->ind = 0;
  1243.         env->adr = FALSE;
  1244.         return;
  1245.     }
  1246.  
  1247.     variable(env);
  1248.  
  1249.     if (iftoken(AUTOINC)) {
  1250.         register INTEGER value;
  1251.         env2 = *env;
  1252.         rvalue(&env2);
  1253.         value = env2.value +
  1254.             (((env->ind == 1 && env->size == sizeof(INTEGER)) ||
  1255.             env->ind > 1) ? sizeof(INTEGER) : 1);
  1256.         store(env, value);
  1257.         *env = env2;
  1258.         return;
  1259.     }
  1260.  
  1261.     if (iftoken(AUTODEC)) {
  1262.         register INTEGER value;
  1263.         env2 = *env;
  1264.         rvalue(&env2);
  1265.         value = env2.value -
  1266.             (((env->ind == 1 && env->size == sizeof(INTEGER)) ||
  1267.             env->ind > 1) ? sizeof(INTEGER) : 1);
  1268.         store(env, value);
  1269.         *env = env2;
  1270.         return;
  1271.     }
  1272. }
  1273.  
  1274. static void variable(env)    /* Variables, arrays and functions */
  1275. register ENV *env;
  1276. {
  1277.     register short tok;
  1278.     register INTEGER index;
  1279.     register short size;
  1280.  
  1281.     primary(env);
  1282.     switch (tok = nexttoken()) {
  1283.         case LPAREN:
  1284.             tptr--;
  1285.             rvalue(env);
  1286.             if (skipping) {
  1287.                 skippair(LPAREN, RPAREN);
  1288.                 env->value = 1;
  1289.             } else
  1290.                 env->value = pfunction((Byte *)env->value, env->sp);
  1291.             env->ind = 0;
  1292.             env->size = sizeof(INTEGER);
  1293.             env->adr = FALSE;
  1294.             break;
  1295.         case LBRACKET:
  1296.             index = expression(env->sp);
  1297.             needtoken(RBRACKET);
  1298.             rvalue(env);
  1299.             if (!env->ind)
  1300.                 error(SYNTAX, EmptyStr);
  1301.             --(env->ind);
  1302.             switch (env->size) {
  1303.                 case 1:
  1304.                     size = (env->ind) ? sizeof(INTEGER) : 1;
  1305.                     break;
  1306.                 case sizeof(INTEGER):
  1307.                     size = sizeof(INTEGER);
  1308.                     break;
  1309.                 default:
  1310.                     error(SYNTAX, EmptyStr);
  1311.             }
  1312.             env->value += index * size;
  1313.             env->adr = TRUE;
  1314.             break;
  1315.         default:
  1316.             tptr--;
  1317.     }
  1318. }
  1319.  
  1320. static void primary(env)    /* Constants, strings and identifiers */
  1321. register ENV *env;
  1322. {
  1323.     short tok;
  1324.     register SYMBOL *sym;
  1325.  
  1326.     switch (tok = nexttoken()) {
  1327.         case LPAREN:
  1328.             assign(env);
  1329.             needtoken(RPAREN);
  1330.             break;
  1331.         case CONSTANT:
  1332.             env->value = a2x((Byte *)tptr);
  1333.             bypass();
  1334.             env->ind = 0;
  1335.             env->size = sizeof(INTEGER);
  1336.             env->adr = FALSE;
  1337.             break;
  1338.         case STRING:
  1339.             env->value = (INTEGER)tptr;
  1340.             bypass();
  1341.             env->ind = 0;
  1342.             env->size = sizeof(INTEGER);
  1343.             env->adr = FALSE;
  1344.             break;
  1345.         case IDENT:
  1346.             /* First check locals, then globals */
  1347.             if (!(sym = ifsymbol(env->sp, tptr, SymTop)))
  1348.                 sym = findsymbol(Globals, tptr, EndGlobals);
  1349.             bypass();
  1350.             env->value = (INTEGER)&sym->value;
  1351.             /* Adjust address of char variables */
  1352.             if (sym->size == 1 && sym->ind == 0)
  1353.                 env->value += sizeof(INTEGER) - 1;
  1354.             env->ind = sym->ind;
  1355.             env->size = sym->size;
  1356.             env->adr = TRUE;
  1357.             break;
  1358.         default:
  1359.             error(OUTOFPLACE, token2str(tok));
  1360.     }
  1361. }
  1362.  
  1363. /* ----- Skip the tokens between a matched pair ------------------------ */
  1364.  
  1365. static void skippair(ltok, rtok)
  1366. register Byte ltok;
  1367. register Byte rtok;
  1368. {
  1369.     register short pairct = 0;
  1370.     register Byte tok;
  1371.  
  1372.     needtoken(tok = ltok);
  1373.     while (TRUE) {
  1374.         if (tok == ltok)
  1375.             pairct++;
  1376.         if (tok == rtok)
  1377.             if (--pairct == 0)
  1378.                 break;
  1379.         if ((tok = nexttoken()) == EOF)
  1380.             error(MATCHERR, token2str(ltok));
  1381.     }
  1382. }
  1383.  
  1384. /* ----- A specified token is required next ---------------------------- */
  1385.  
  1386. static void needtoken(tk)
  1387. register Byte tk;
  1388. {
  1389.     if (nexttoken() != tk)
  1390.         error(MISSING, token2str(tk));
  1391. }
  1392.  
  1393. /* ----- Test for a specified token next in line ----------------------- */
  1394.  
  1395. static Boolean iftoken(tk)
  1396. register Byte tk;
  1397. {
  1398.     if (nexttoken() == tk)
  1399.         return TRUE;
  1400.     --tptr;
  1401.     return FALSE;
  1402. }
  1403.  
  1404. /* ----- Get the next token from the buffer ---------------------------- */
  1405.  
  1406. static Byte nexttoken()
  1407. {
  1408.     while (*tptr == LINENO)
  1409.         tptr++;
  1410.     return *tptr++;
  1411. }
  1412.  
  1413. /* ----- Add a symbol to the symbol table ------------------------------ */
  1414.  
  1415. static SYMBOL *addsymbol(s, name, value, size, ind)
  1416. register SYMBOL *s;                /* Start of local symbol table */
  1417. register Byte *name;            /* Pointer to symbol name */
  1418. register INTEGER value;            /* Value of symbol */
  1419. register Byte size;                /* Size of value */
  1420. register Byte ind;                /* Indirection level */
  1421. {
  1422.     if (ifsymbol(s, name, SymTop))
  1423.         error(DUPL_DECLARE, name);        /* Already declared */
  1424.     s = --SymTop;
  1425.     if ((Byte *)s < StackPtr)
  1426.         error(TABLEOVERFLOW, name);        /* Symbol table full */
  1427.     s->name = name;
  1428.     s->value = value;
  1429.     s->size = size;
  1430.     s->ind = ind;
  1431.     return s;
  1432. }
  1433.  
  1434. /* ----- Find a symbol on the symbol table (error if not found) -------- */
  1435.  
  1436. static SYMBOL *findsymbol(s, sym, ends)
  1437. register SYMBOL *s;                /* Start of local symbol table */
  1438. register Byte *sym;                /* Symbol name */
  1439. register SYMBOL *ends;            /* End of local symbol table */
  1440. {
  1441.     if (!(s = ifsymbol(s, sym, ends)))
  1442.         error(UNDECLARED, sym);
  1443.     return s;
  1444. }
  1445.  
  1446. /* ----- Test for a symbol on the symbol table ------------------------- */
  1447.  
  1448. static SYMBOL *ifsymbol(s, sym, sp)
  1449. register SYMBOL *s;                /* Start of local symbol table */
  1450. register Byte *sym;                /* Symbol name */
  1451. register SYMBOL *sp;            /* End of local symbol table */
  1452. {
  1453.     while (sp < s) {
  1454.         if (!strcmp((char *)sym, (char *)sp->name))
  1455.             return sp;
  1456.         sp++;
  1457.     }
  1458.     return NULL;
  1459. }
  1460.  
  1461. /* ----- Post an error to the shell ------------------------------------ */
  1462.  
  1463. static void error(erno, s)
  1464. register enum errs erno;
  1465. register Byte *s;
  1466. {
  1467.     register Byte *p;
  1468.     register n;
  1469.  
  1470.     if (linenumber)
  1471.         n = linenumber;
  1472.     else {
  1473.         if (tptr < TokenBuffer || tptr >= LoMem)
  1474.             n = 0;    /* Happens if main() is not found */
  1475.         else {
  1476.             for (n = 1, p = TokenBuffer; p <= tptr; p++)
  1477.                 if (*p == LINENO)
  1478.                     n++;
  1479.         }
  1480.     }
  1481.     SI_Error(erno, s, n);
  1482. }
  1483.  
  1484. /* ----- Convert token to string (for error messages) ------------------ */
  1485.  
  1486. static Byte *token2str(token)
  1487. register short token;
  1488. {
  1489.     static Byte s[2];
  1490.     register Byte *p = s;
  1491.  
  1492.     switch (token) {
  1493.         case AUTOINC:
  1494.             *p++ = '+';
  1495.             *p++ = '+';
  1496.             break;
  1497.         case AUTODEC:
  1498.             *p++ = '-';
  1499.             *p++ = '-';
  1500.             break;
  1501.         case EQUALTO:
  1502.             *p++ = '=';
  1503.             *p++ = '=';
  1504.             break;
  1505.         case NOTEQUAL:
  1506.             *p++ = '!';
  1507.             *p++ = '=';
  1508.             break;
  1509.         case GE:
  1510.             *p++ = '>';
  1511.             *p++ = '=';
  1512.             break;
  1513.         case LE:
  1514.             *p++ = '<';
  1515.             *p++ = '=';
  1516.             break;
  1517.         case AUTOADD:
  1518.             *p++ = '+';
  1519.             *p++ = '=';
  1520.             break;
  1521.         case AUTOSUB:
  1522.             *p++ = '-';
  1523.             *p++ = '=';
  1524.             break;
  1525.         case AUTOMUL:
  1526.             *p++ = '*';
  1527.             *p++ = '=';
  1528.             break;
  1529.         case AUTODIV:
  1530.             *p++ = '/';
  1531.             *p++ = '=';
  1532.             break;
  1533.         case AND:
  1534.             *p++ = '&';
  1535.         case ADDRESS:
  1536.             *p++ = '&';
  1537.             break;
  1538.         case OR:
  1539.             *p++ = '|';
  1540.         default:
  1541.             *p++ = token;
  1542.     }
  1543.     *p = '\0';
  1544.     return s;
  1545. }
  1546.  
  1547. /* ----- Convert long to string ---------------------------------------- */
  1548.  
  1549. static void x2str(num, str)
  1550. register long num;                /* Number to convert */
  1551. register Byte *str;                /* String for result */
  1552. {
  1553.     register short n;
  1554.     register Byte nibble;
  1555.     register short flg = FALSE;
  1556.  
  1557.     for (n = 28; n >=0 ; n -= 4) {
  1558.         if (nibble = (num >> n) & 0x0F)
  1559.             flg = TRUE;
  1560.         if (flg)
  1561.             *str++ = nibble | 0x30;
  1562.         }
  1563.     *str = 0;
  1564. }
  1565.  
  1566. /* ----- Convert string to long ---------------------------------------- */
  1567.  
  1568. long a2x(s)
  1569. register Byte *s;
  1570. {
  1571.     register unsigned long v = 0;
  1572.  
  1573.     while (isspace(*s))
  1574.         s++;
  1575.     while (*s >= 0x30 && *s <= 0x3F)    /* '0' .. '?' */
  1576.         v = (v << 4) + (*s++ & 0x0F);
  1577.     return (long)v;
  1578. }
  1579.